perm filename ARITH.FAI[XGP,BGB] blob sn#038134 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	SUBR(SQRT)
C00006 00003	BEGIN SINCOS		MODIFIED OLDE LIB40 SINE & COSINE - BGB.
C00008 00004	SUBR(REALIN)
C00011 ENDMK
C⊗;
;SUBR(SQRT)
TITLE ARITH
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
	A←0 ↔ B←1 ↔ C←2
	MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2

;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
	ASHC B,-=27↔SUBI B,201	;GET EXPONENT IN B, FRACTION IN C.
	ROT B,-1		;CUT EXP IN HALF, SAVE ODD BIT
	HRRM B,L↔LSH B,-=35	;USE THAT ODD BIT.
	ASH C,-10↔FSC C,177(B)	;0.25 < FRACTION < 1.00

;LINEAR APPROXIMATION TO SQRT(F).
	MOVEM C,A
	FMP C,[0.8125↔0.578125](B)
	FAD C,[0.302734↔0.421875](B)

;TWO ITERATIONS OF NEWTON'S METHOD.
	MOVE B,A
	FDV B,C↔FAD C,B↔FSC C,-1
	FDV A,C↔FADR A,C
     L: FSC A,0↔MOVE 1,A↔POP P,2
	POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS		;MODIFIED OLDE LIB40 SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
	A←1 ↔ B←2 ↔ C←3
↑COS:	SKIPA A,ARG1
↑SIN:	SKIPA A,ARG1
	FADR  A,HALFPI			;COS(X) = SIN(X+π/2).
	MOVM B,A↔CAMG B,[17B5]↔POP1J	;FOR SMALL X, SIN(X)=X.

;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
	FDVR B,HALFPI
	LAC C,B↔FIX C,233000
	CAILE C,3↔GO[
	TRZ C,3↔FSC C,233
	FSBR B,C↔GO .-3]		;MODULO 2π.
	GO .+1(C)↔GO .+4↔JFCL↔GO[
	FSBRI B,(2.0)↔MOVNS B↔GO .+2]	;SIN(X+π)=SIN(-X)
	FSBRI B,(4.0)			;SIN(X+2π)=SIN(X)
	SKIPGE A↔MOVNS	B		;SIN(-X) = -SIN(X).

;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
	DAC B,C↔FMPR B,B	
	LAC A,[164475536722]↔FMP A,B
	FAD A,[606315546346]↔FMP A,B
	FAD A,[175506321276]↔FMP A,B
	FAD A,[577265210372]↔FMP A,B
	FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:	201622077325 ;PI/2
	LIT
BEND;-------------------------------------------------------------
SUBR(REALIN)
BEGIN REALIN;
;<EXPR>		::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM>		::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY>	::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
	CALL(TERM)
	CAIN 1,"+"
	GO [ PUSH P,0
	     CALL(TERM)
	     FADR 0,(P)
  	     SUB P,[XWD 1,1]
	     GO REALIN+1 ]
	CAIN 1,"-"
	GO [ PUSH P,0
	     CALL(TERM)
	     MOVN 0,0
	     FADR 0,(P)
  	     SUB P,[XWD 1,1]
	     GO REALIN+1 ]
	CAIN 1,15
	INCHWL 1
	POP0J
	POP0J
TERM:	CALL(PRIMARY)
TERM2:	CAIN 1,"*"
	GO [ PUSH P,0
	     CALL(PRIMARY)
	     FMPR 0,(P)
  	     SUB P,[XWD 1,1]
	     GO TERM2 ]
	CAIN 1,"/"
	GO [ PUSH P,0
	     CALL(PRIMARY)
	     EXCH 0,(P)
	     FDVR 0,(P)
  	     SUB P,[XWD 1,1]
	     GO TERM2 ]
	POP0J
;BEGIN REALIN	; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0:	INCHWL 1
	CAIN 1," "↔GO .-2
	CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
	CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
	      GETRET: INCHWL 1↔GO L3]
	CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
		      CAIN 1,")"↔GO GETRET
		      OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔		      POP0J]
	SKIPA
L1:	INCHWL 1
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3:	SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
END;